home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / FILEFWD.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  16KB  |  469 lines
  1. UNIT FileFwd;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ File forwarding, with letter and security     Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. PROCEDURE ForwardFiles(AddSome: Boolean);
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES Dos, OpDos, OpString, OpDate, OpRoot,
  22.      OutUtil, FileUtil, OproUtil, Globals, OpusMsg, PTpl, StrUtil, MailUtil,
  23.      LogFile, InterCom, Send2Utl, NetFile, Input, SimpDB, PoPTypes, Util,
  24.      NodeList, AreaMisc, FuncSrvr;
  25.  
  26. VAR
  27.   FwdRec : PFileFwd;
  28.  
  29.   PROCEDURE MoveFile(CONST FileName, WhereToPut: PathStr; Touch: Boolean);
  30.   BEGIN
  31.     AddLog('+','Moving '+JustFileName(FileName)+' to '+WhereToPut);
  32.     CopyFile(FileName, AddBackSlash(WhereToPut)+JustFileName(FileName), Touch, True);
  33.   END;
  34.  
  35.   PROCEDURE AddFileToFilesBbs(CONST WhereToPut: PathStr; CONST FileName, Description: String);
  36.   LABEL
  37.     DoItAgain;
  38.   VAR
  39.     Line, Newname, S: STRING;
  40.     NewFilesBBS,
  41.     FilesBbs :  PBufTextFile;
  42.     Flag: Boolean;
  43.     i   : Byte;
  44.   BEGIN
  45.     NewName:=MakeTaskFileName(AddBackSlash(WhereToPut)+'FILES.$$$');
  46.     New(NewFilesBBS, Init(NewName, SCreate, Max64k(MaxAvail DIV 2)));
  47.     New(FilesBbs, Init(WhereToPut+'FILES.BBS', SOpenRead, Max64k(MaxAvail-1024)));
  48.     IF FilesBbs=NIL THEN
  49.     BEGIN
  50.       AddLog('!','No FILES.BBS found in '+WhereToPut+', creating one');
  51.       NewFilesBBS^.WriteLn(#13#10' Once upon a time in the west....'#13#10);
  52.       Flag:=True;
  53.     END ELSE
  54.     BEGIN
  55.       Flag:=False;
  56.       IF FwdRec^.AddBeforeLine>0 THEN
  57.       BEGIN
  58.         FOR i:=2 TO FwdRec^.AddBeforeLine DO
  59.           IF NOT FilesBBS^.EoF THEN
  60.           BEGIN
  61.             FilesBBS^.ReadLn(s);
  62.             NewFilesBBS^.WriteLn(s);
  63.           END;
  64.       END ELSE
  65.       BEGIN
  66. DoItAgain:
  67.         IF FilesBBS<>NIL THEN
  68.         BEGIN
  69.           WHILE NOT FilesBBS^.EoF DO
  70.           BEGIN
  71.             FilesBBS^.ReadLn(s);
  72.             NewFilesBBS^.WriteLn(s);
  73.           END;
  74.         END;
  75.         Flag:=True;
  76.       END;
  77.     END;
  78.     Line:=CPad(FileName,13)+ReplaceStr(Description, FileName);
  79.     IF Cfg.AreaMan.InsDLCnt THEN AddDlC(Line);
  80.     NewFilesBbs^.WriteLn(Line);
  81.     IF FilesBbs<>NIL THEN
  82.     BEGIN
  83.       IF NOT Flag AND (FwdRec^.AddBeforeLine>0) THEN GOTO DoItAgain;
  84.       Dispose(FilesBbs, Done);
  85.       FilesBbs:=NIL;
  86.     END;
  87.     Dispose(NewFilesBBS, Done);
  88.     DeleteFile(AddBackSlash(WhereToPut)+'FILES.BAK');
  89.     Flag:=False;
  90.     IF ExistFile(WhereToPut+'FILES.BBS') AND (NOT RenameFile(WhereToPut+'FILES.BBS',WhereToPut+'FILES.BAK')) THEN Flag:=TRUE;
  91.     IF (NOT Flag) AND (NOT RenameFile(newname,WhereToPut+'FILES.BBS')) THEN Flag:=TRUE;
  92.     IF (NOT Flag) AND ExistFile(WhereToPut+'FILES.BAK')  AND (NOT DeleteFile(WhereToPut+'FILES.BAK')) THEN Flag:=TRUE;
  93.     IF Flag THEN AddLog('!','Error updating '+WhereToPut+'FILES.BBS');
  94.   END;
  95.  
  96.   PROCEDURE ForwardFiles(AddSome: Boolean);
  97.   TYPE
  98.     FwdSysOpType=RECORD
  99.       adr      : TFidoAddress;
  100.       Name     : S35;
  101.       MsgName  : S12;
  102.     END;
  103.     TabType=ARRAY[1..150] OF FwdSysOpType;
  104.   VAR
  105.     FwdFile   : TNetFile;
  106.     Sr        : SearchRec;
  107.     s,
  108.     ss        : String;
  109.     MsgHeadRec : MsgHdrType;
  110.     BufSiz    : WORD;
  111.     i, Got    : Integer;
  112.     f         : File;
  113.     TitF      : PTitFile;
  114.     Buf       : Pointer;
  115.     MsgDir,NewName : PathStr;
  116.     Tf        : PBufTextFile;
  117.     NumSysOpNames : BYTE;
  118.     SysOpName : ^TabType;
  119.     SendTab   : SendToTabType;
  120.     Found     : BOOLEAN;
  121.     Ift       : TInboundFile;
  122.     NodeStat  : TNodeStat;
  123.  
  124.     PROCEDURE SendFileToNodes(CONST SendTo: SendToType; CONST FileName: PathStr);
  125.     VAR
  126.       NodeRec : TNodeInfo;
  127.       Temp    : String;
  128.       x,i,Num : BYTE;
  129.       ch      : CHAR;
  130.  
  131.       FUNCTION FindSysOpEntry(CONST Adr: TFidoAddress): BYTE;
  132.       VAR
  133.         i,x:BYTE;
  134.       BEGIN
  135.         x:=0;
  136.         FOR i:=1 TO NumSysOpNames DO
  137.           IF CmpAdr(Adr,SysOpName^[i].Adr) THEN
  138.           BEGIN
  139.             x:=i;
  140.             Break;
  141.           END;
  142.         FindSysOpEntry:=x;
  143.       END;
  144.  
  145.     BEGIN
  146.       IF (SendTo[1]='') And (SendTo[2]='') THEN
  147.         AddLog('+','No forward of '+JustFileName(FileName))
  148.       ELSE
  149.       BEGIN
  150.         FOR i:=1 TO 2 DO
  151.         BEGIN
  152.           IF SendTo[i]<>'' THEN AddLog('+','Sending '+JustFileName(FileName)+' to '+SendTo[i]);
  153.         END;
  154.         ReadSendTo(SendTo,SendTab,Num);
  155.         FOR i:=1 TO Num DO
  156.         BEGIN
  157.           IF (FindNodeInfo(NodeRec,SendTab[i])) And (NodeRec.SendFwdLetter) THEN
  158.           BEGIN
  159.             x:=FindSysOpEntry(SendTab[i]);
  160.             IF x=0 THEN
  161.             BEGIN
  162.               FwdSysOpName:=GetSysOpName(SendTab[i]);
  163.               INC(NumSysOpNames);
  164.               SysOpName^[NumSysOpNames].Name:=FwdSysOpName;
  165.               SysOpName^[NumSysOpNames].Adr:=SendTab[i];
  166.               SysOpName^[NumSysOpNames].MsgName:=ForceExtension(InventPktName,'TMP');
  167.               x:=NumSysOpNames;
  168.             END;
  169.             temp:=MsgDir+'\'+SysOpName^[x].MsgName;
  170.             IF NOT ExistFile(temp) THEN
  171.             BEGIN
  172.               New(tf, Init(Temp, SCreate, 256));
  173.               IF tf<>NIL THEN
  174.               BEGIN
  175.                 tf^.WriteLn(KludgeLines(Cfg.Addresses[Cfg.MainAdrNum],SendTab[i]));
  176.                 Dispose(tf, Done);
  177.               END ELSE
  178.                 AddLog('!', 'Not enough memory to open: '+Temp);
  179.               AddTpl(temp,'FWDHEADER',sr);
  180.             END;
  181.             OkPath:=FwdRec^.Description;
  182.             AddTpl(temp,'FWDBODY',sr);
  183.           END;
  184.           CASE NodeRec.Flavor OF
  185.             'N' : ch:='F';
  186.             'C',
  187.             'I',
  188.             'D' : ch:=NodeRec.Flavor;
  189.             ELSE ch:='H';
  190.           END;
  191.           SendAFile(FileName,SendTab[i],Ch,STNothing);
  192.         END;
  193.       END;
  194.     END;
  195.  
  196.     PROCEDURE AddFilesToForwardList;
  197.     VAR
  198.       b   : Boolean;
  199.       s   : PathStr;
  200.       Adr : TFidoAddress;
  201.     BEGIN
  202.       FILLCHAR(Adr,SizeOf(Adr),0);
  203.       REPEAT
  204.         s:=Cfg.Inbound[nsKnown]+'*.*';
  205.         b:=SelectFile(s);
  206.         IF b THEN
  207.         BEGIN
  208.           IF GetAddress(8,2,Adr,1502) THEN
  209.           BEGIN
  210.             FILLCHAR(Ift,SizeOf(Ift),0);
  211.             WITH Ift DO
  212.             BEGIN
  213.               s:=JustFileName(s)+'.';
  214.               FileName:=COPY(s,1,POS('.',s)-1);
  215.               From:=Adr;
  216.               RecvDate:=Today;
  217.               RecvTime:=CurrentTime;
  218.               TaskNum:=Cfg.TaskNumber;
  219.             END;
  220.             TitF^.AddRec(Ift);
  221.           END;
  222.         END;
  223.       UNTIL NOT b;
  224.     END;
  225.  
  226.     PROCEDURE RemoveExcessFiles;
  227.     TYPE
  228.       SrType=RECORD
  229.         Name : S12;
  230.         Time : LONGINT;
  231.       END;
  232.       TabType=ARRAY[1..255] OF SrType;
  233.     VAR
  234.       Tab:^TabType;
  235.       i,Num:INTEGER;
  236.       sr : SearchRec;
  237.       DelStr : String;
  238.  
  239.       PROCEDURE SortTab;
  240.       VAR
  241.         i:INTEGER;
  242.         Flag:BOOLEAN;
  243.         t:SrType;
  244.       BEGIN
  245.         Flag:=TRUE;
  246.         WHILE Flag DO
  247.         BEGIN
  248.           Flag:=FALSE;
  249.           FOR i:=1 TO Num-1 DO
  250.             IF Tab^[i].Time>Tab^[i+1].Time THEN
  251.             BEGIN
  252.               t:=Tab^[i];
  253.               Tab^[i]:=Tab^[i+1];
  254.               Tab^[i+1]:=t;
  255.               Flag:=TRUE;
  256.             END;
  257.         END;
  258.       END;
  259.  
  260.     BEGIN
  261.       IF FwdRec^.KeepMax>0 THEN
  262.       BEGIN
  263.         New(Tab);
  264.         Num:=0;
  265.         FINDFIRST(AddBackSlash(FwdRec^.WhereToPut)+FwdRec^.FileName,Archive,sr);
  266.         WHILE DosError=0 DO
  267.         BEGIN
  268.           INC(Num);
  269.           WITH Tab^[Num] DO
  270.           BEGIN
  271.             Name:=sr.Name;
  272.             Time:=sr.Time;
  273.           END;
  274.           FINDNEXT(sr);
  275.         END;
  276.         FindClose(sr);
  277.         SortTab;
  278.         DelStr:='';
  279.         FOR i:=1 TO Num-FwdRec^.KeepMax DO
  280.         BEGIN
  281.           IF DeleteFile(AddBackSlash(FwdRec^.WhereToPut)+Tab^[i].Name) THEN
  282.             DelStr:=DelStr+' '+Tab^[i].Name;
  283.         END;
  284.         IF DelStr<>'' THEN
  285.           AddLog('*', 'To keep a max of '+Long2Str(FwdRec^.KeepMax)+' I have deleted: '+Trim(DelStr));
  286.         Dispose(Tab);
  287.       END;
  288.     END;
  289.  
  290.   BEGIN
  291. {$IFNDEF PoPLite}
  292.     IF (Cfg.TaskType=2) AND (NOT AddSome) THEN
  293.     BEGIN
  294.       RequestFunction(fsForwardFiles);
  295.       EXIT;
  296.     END;
  297.     FillChar(SendTab, SizeOf(SendTab), 0);
  298.     IF Not SetInterCom(ICFileFwd,SendTab[1],False) THEN Exit;
  299.  
  300.     IF FwdFile.Open(PoPFileFwdFileName, SizeOf(TFileFwd),False) THEN
  301.     BEGIN
  302.       AddLog('+','Searching for files to forward');
  303.       NumSysOpNames:=0;
  304.       New(SysOpName);
  305.       New(FwdRec);
  306.       New(TitF, Open(True));
  307.       IF AddSome THEN AddFilesToForwardList;
  308.       MsgDir:=StartPath+'FWDMSG.'+HexB(Cfg.TaskNumber);
  309.       MakeFullDir(MsgDir);
  310.       FOR NodeStat:=nsUnKnown TO nsPassword DO
  311.       BEGIN
  312.         IF (Cfg.InboundToDo[NodeStat] AND itd_File)<>0 THEN
  313.         BEGIN
  314.           IF Cfg.FwdFile.PreCmd<>'' THEN RunCmd(Cfg.FwdFile.PreCmd,Cfg.Inbound[NodeStat]);
  315.           WHILE Not FwdFile.EoF DO
  316.           BEGIN
  317.             FwdFile.Read(FwdRec^, Keep, Wait);
  318.             FindFirst(Cfg.Inbound[NodeStat]+FwdRec^.FileName, AnyFile, Sr);
  319.             WHILE DosError=0 DO
  320.             BEGIN
  321.               Assign(f, Cfg.Inbound[NodeStat]+Sr.Name); FileMode:=ShareRW+ShareDenyRW;
  322.               Reset(f);
  323.               IF IOResult<>0 THEN
  324.               BEGIN
  325.                 AddLog('!','Can''t access: '+Sr.Name+' skipping file!');
  326.                 FindNext(Sr);
  327.                 Continue;
  328.               END ELSE
  329.                 Close(f);
  330.  
  331.               { Check at vi ikke processer en fil der er blevet renamet til .SEC }
  332.               IF (JustExtension(Sr.Name)='SEC') AND (Pos('.*', FwdRec^.FileName)>0) THEN Continue;
  333.  
  334.               IF (FwdRec^.CheckDate) AND (Sr.Time<=FwdRec^.LastForward) THEN
  335.               BEGIN
  336.                 IF Cfg.FwdFile.SecureDir='' THEN
  337.                   NewName:=UniqueName(Cfg.Inbound[NodeStat]+ForceExtension(Sr.name,'OLD'))
  338.                 ELSE
  339.                   NewName:=UniqueName(Cfg.FwdFile.SecureDir+Sr.name);
  340.                 IF CopyFile(Cfg.Inbound[NodeStat]+Sr.Name,NewName, False,True)=0 THEN
  341.                 BEGIN
  342.                   AddLog('!',Sr.Name+' is not a new file, renamed to: '+JustFileName(NewName));
  343.                 END ELSE
  344.                   AddLog('!','Error moving '+Sr.Name+' to '+NewName)
  345.               END ELSE
  346.               BEGIN
  347.                 Found:=TitF^.FindFile(Sr.Name, Ift);
  348.                 IF NOT Found THEN
  349.                 BEGIN
  350.                   FillChar(Ift,SizeOf(Ift),0);
  351.                   Found:=True;
  352.                 END ELSE
  353.                   Found:=(FwdRec^.GetFrom.Zone=0) OR (CmpAdr(FwdRec^.GetFrom, Ift.From));
  354.                 IF NOT Found THEN
  355.                 BEGIN
  356.                   IF Cfg.FwdFile.SecureDir='' THEN
  357.                     NewName:=UniqueName(Cfg.Inbound[NodeStat]+ForceExtension(Sr.name,'SEC'))
  358.                   ELSE
  359.                     NewName:=UniqueName(Cfg.FwdFile.SecureDir+Sr.name);
  360.                   IF CopyFile(Cfg.Inbound[NodeStat]+Sr.Name,NewName, False,True)=0 THEN
  361.                   BEGIN
  362.                     WITH FwdRec^.GetFrom DO
  363.                       AddLog('!','SECURITY: Got '+Sr.Name+' From: '+Address2Str(Ift.From)+
  364.                                  ' should be: '+Address2Str(FwdRec^.GetFrom)+', renamed to: '+JustFileName(Newname));
  365.                   END ELSE
  366.                     AddLog('!','Error moving '+Sr.Name+' to '+NewName)
  367.                 END ELSE
  368.                 BEGIN
  369.                   IF (ExistFile(AddBackSlash(FwdRec^.WhereToPut)+Sr.Name)) And (FwdRec^.KillDupe) THEN
  370.                   BEGIN
  371.                     DeleteFile(Cfg.Inbound[NodeStat]+Sr.Name);
  372.                     AddLog('!','Killing dupe: '+Sr.Name);
  373.                   END ELSE
  374.                   BEGIN
  375.                     IF DriveFree(Byte(FwdRec^.WhereToPut[1])-64)>Sr.Size THEN
  376.                     BEGIN
  377.                       IF FwdRec^.BeforeCmd<>'' THEN
  378.                       BEGIN
  379.                         Ss:=FwdRec^.BeforeCmd;
  380.                         Replace(ss,'$FILENAME',sr.Name,0);
  381.                         RunCmd(ss,Cfg.Inbound[NodeStat]);
  382.                       END;
  383.                       IF ExistFile(Cfg.Inbound[NodeStat]+Sr.name) THEN
  384.                       BEGIN
  385.                         MoveFile(Cfg.Inbound[NodeStat]+Sr.Name,AddBackSlash(FwdRec^.WhereToPut),FwdRec^.TouchFile);
  386.                         IF (FwdRec^.AddToFiles) AND (Cfg.BBS.BBSType<>btOpus170) THEN
  387.                           AddFileToFilesBbs(AddBackSlash(FwdRec^.WhereToPut), Sr.Name, FwdRec^.Description);
  388.                         SendFileToNodes(FwdRec^.SendTo,AddBackSlash(FwdRec^.WhereToPut)+Sr.Name);
  389.                         IF FwdRec^.AfterCmd<>'' THEN
  390.                         BEGIN
  391.                           Ss:=FwdRec^.AfterCmd;
  392.                           Replace(ss,'$FILENAME',sr.Name,0);
  393.                           RunCmd(ss,Copy(FwdRec^.WhereToPut,1,Length(AddBackSlash(FwdRec^.WhereToPut))-1));
  394.                         END;
  395.                         FwdRec^.LastForward:=Sr.Time;
  396.                         RemoveExcessFiles;
  397.                         FwdFile.PutRec(FwdRec^,FwdFile.FilePos-1) ;
  398.                       END ELSE
  399.                         AddLog('!','File '+Sr.Name+' disappered???');
  400.                     END ELSE
  401.                       AddLog('!','Not enough space on '+FwdRec^.WhereToPut[1]+': to move '+Sr.Name);
  402.                   END; {else dupe}
  403.                 END;
  404.               END; {else old}
  405.               FindNext(Sr);
  406.             END; {while doserror}
  407.             FindClose(Sr);
  408.             FwdFile.UnLock(FwdFile.FilePos-1);
  409.           END; {while not eof}
  410.         END;
  411.       END;
  412.       FwdFile.Close;
  413.       Dispose(TitF, Close);
  414.       FindFirst(MsgDir+'\*.*', Archive,sr);
  415.       IF DosError=0 THEN
  416.       BEGIN
  417.         AddLog('*','Writing forward messages');
  418.         IF MaxAvail>65520 THEN BufSiz:=65520 ELSE BufSiz:=MaxAvail;
  419.         GetMem(buf,BufSiz);
  420.         WHILE DOSERROR=0 DO
  421.         BEGIN
  422.           AddTpl(MsgDir+'\'+Sr.Name,'FWDFOOT',sr);
  423.           FillChar(MsgHeadRec,SizeOf(MsgHeadRec),0);
  424.           WITH MsgHeadRec DO
  425.           BEGIN
  426.             Str2AsciiZ(Cfg.SysOp,FromUser,36);
  427.             FwdSysOpName:='SysOp';
  428.             FOR i:=1 TO NumSysOpNames DO
  429.               IF (SysOpName^[i].MsgName=sr.name) THEN
  430.                BEGIN
  431.                  FwdSysOpName:=SysOpName^[i].Name;
  432.                  Break;
  433.                END;
  434.             Str2AsciiZ(FwdSysOpName,ToUser,36);
  435.             Str2AsciiZ(Cfg.FwdFile.Subject,Subject,72);
  436.             SetTimeStamp(MsgHeadRec);
  437.             DestNode:=SysOpName^[i].Adr.Node;
  438.             OrigNode:=Cfg.Addresses[Cfg.MainAdrNum].Node;
  439.             DestNet:=SysOpName^[i].Adr.Net;
  440.             OrigNet:=Cfg.Addresses[Cfg.MainAdrNum].Net;
  441.             Attribute:=Byte(Cfg.FwdFile.MsgPrivate)+Byte(Cfg.FwdFile.KillSent)*$80+
  442.                        MsgLocal;
  443.           END;
  444.           Assign(f, MsgDir+'\'+Sr.Name); FileMode:=ShareRead+ShareDenyW;
  445.           Reset(f,1);
  446.           FillChar(Buf^,BufSiz,0);
  447.           BlockRead(f,Buf^,BufSiz,Got);
  448.           Close(f);
  449.           WITH Cfg.MailScanner DO
  450.             IF NetMailDir<>'' THEN
  451.               WriteMsg(NetMailDir,GetHighestMsg(NetMailDir)+1, MsgHeadRec,Got,Buf);
  452.           DeleteFile(MsgDir+'\'+Sr.Name);
  453.           FindNext(sr);
  454.         END;
  455.         FindClose(sr);
  456.         FreeMem(Buf,BufSiz);
  457.       END;
  458.       RmDir(MsgDir);
  459.       Dispose(FwdRec);
  460.       Dispose(SysOpName);
  461.       AddLog('+','File forward done');
  462.     END;
  463. {$ELSE}
  464.   AddLog('!', 'Not implemented in Portal of Power/Lite');
  465. {$ENDIF}
  466.   END;
  467.  
  468. END.
  469.